COMMENT ⊗   VALID 00005 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	.REQUIRE "LSPMAC.PUB[LSP,CLT]" source_file
C00003 00003	.hd206 FALL 1978
C00009 00004	.LSPFONT
C00010 00005	.hd206 FALL 1978
C00019 ENDMK
C⊗;
.REQUIRE "LSPMAC.PUB[LSP,CLT]" source_file;
.PAGE FRAME 56 HIGH 80 WIDE;
.evenleftborder ← oddleftborder ← 1000;
.area text lines 1 to 56;
.place text;
.
.MACRO  hd206 (TERM) ⊂
.BEGIN    NOFILL  TURNON "←→"
←COMPUTER SCIENCE DEPARTMENT
←STANFORD UNIVERSITY
.SKIP  
CS206  ←COMPUTING WITH SYMBOLIC EXPRESSIONS  →TER¬m
.TURNOFF
.END ⊃
.
.
.MACRO hw (NUMBER, DUEDATE) ⊂
.   BEGIN TURNON "←"  NOFILL
←PROBLEM SET  NUMBER
←Due  DUEDATE
.   TURNOFF END ⊃
.
.itemmac
.
.PORTION MAINPORTION
.
.hd206 FALL 1978
.skip
.hw 1, |October 24|

	Write LISP programs for each of the functions described below.
For each program turn in the following:
.item←0
.begin nofill indent 12,12

	#.  The internal form of the program.
	#.  The corresponding external form recursive definition.
	#.  A description of how the progam works and why.
	#.  Output from test runs on a variety of input.
.end		
	Late assignments are discouraged and will not be accepted after the 
solutions appear.
.bb Function descriptions.
.item ← 0
.BEGIN INDENT 0,6

#. ⊗sizesort[u] returns a permutation of ⊗u which has smaller length sublists
before larger ones.  Atomic elements should be considered to have 0 length.
Sublists of the same size can be in any order.  The following is one i/o
pair which satisfies the function definition.

⊗⊗⊗sizesort[$$(H (D E) (F G H) (D F) B A)$] = $$(H B A (D E) (D F) (F G H))$.⊗

#. ⊗powerset[u] returns the power-set of set ⊗u.  A set is represented as a
list of elements with no repetitions. Order within the list is unimportant.
The following is one i/o pair which satisfies the function definition.

⊗⊗⊗powerset[$$(A B C)$] = $$((A B C) (A B) (A C) (A) (B C) (B) (C) ())$.⊗

#. ⊗allsub[u,v] returns a list giving all occurrences of the list ⊗u 
as a toplevel sublist of ⊗v. An occurrence is given by the number
denoting the position in ⊗v where the match begins.
The following is one i/o pair which satisfies the function definition.

⊗⊗⊗allsub[$$(A A),(A A A A A)$] = $$(1 2 3 4)$.⊗

#. ⊗allsub![u,v] returns a list giving all occurrences of the list ⊗u 
as a sublist of ⊗v, at any level.  Now an occurrence is a list of numbers
giving the path to beginning to sublist occurrence. 
The following is one i/o pair which satisfies the function definition.

⊗⊗⊗allsub![$$(A),(A (B (A (B (A)))))$] = $$((1) (2 2 1) (2 2 2 2 1))$⊗

#.  ⊗mapexp takes as arguments an S-expression, a unary
function ⊗f1 and a binary function ⊗f2.  It takes the S-expression apart,
applies the unary function to each atom and puts the result back 
together using the binary function
Thus if ⊗f1 is the identity function and ⊗f2 is ⊗cons then ⊗maptree returns
a copy of the S-expression.  If ⊗f1 is ⊗ncons (forms a list of one element)
and ⊗f2 is ⊗append then ⊗maptree returns the ⊗fringe of the S-expression.

#.  Let a graph ⊗g be represented as described in Chapter I of the text
and suppose that whenever there is an edge from ⊗x to ⊗y  there is also 
an edge from ⊗y to ⊗x.  A component of the graph is a collection of 
vertices which are all connected to each other by edge paths but not 
connected to any vertices not in this collection.  Write a function
⊗components to determine the components of a graph ⊗g.  

.END

.LSPFONT
.basicops 
.next page
.hd206 FALL 1978
.skip
.cb |Functions definitions (external and internal form) for assignment 1.|
.item ← 0

#. ⊗sizesort[u]  
.begin  nofill select 2 

⊗⊗        sizesort[u] ← ⊗
⊗⊗            qif qn u qthen qNIL⊗
⊗⊗            qelse addtolist[qa u, sizesort[qd u]]⊗

⊗⊗        addtolist[x,v] ← ⊗
⊗⊗	      qif qn v qthen <x>⊗
⊗⊗	      qelseif len[x] < len[qa v] qthen x . v⊗
⊗⊗	      qelse qa v . addtolist[x,qd v]⊗

⊗⊗	  len[w] ←⊗
⊗⊗	      qif qat w qthen 0 qelse 1 + len[qd w]⊗
.end

.begin nofill select 6

	(DEFUN SIZESORT(U) 
	       (COND ((NULL U) NIL) (T (ADDTOLIST (CAR U) (SIZESORT (CDR U)))))

	(DEFUN ADDTOLIST (X V)
	       (COND ((NULL V) (CONS X NIL))
		     ((LESSP (LEN X) (LEN (CAR V))) (CONS X V))
		     (T (CONS (CAR V) (ADDTOLIST X (CDR V))))))

	(DEFUN LEN (W) (COND ((ATOM W) 0) (T (ADD1 (LEN (CDR W))))))
.end

#. ⊗powerset[u]  
.begin  nofill select 2 

⊗⊗        powerset[u] ← ⊗
⊗⊗            qif qn u qthen <qNIL>⊗
⊗⊗            qelse addfront[qa u,powerset[qd u]]*powerset[qd u]⊗

⊗⊗        addfront[x,v] ← ⊗
⊗⊗	      qif qn v qthen qNIL⊗
⊗⊗	      qelse [x . qa v] . addfront[x, qd v]⊗
.end

.begin nofill select 6

	(DEFUN POWERSET(U) 
	       (COND ((NULL U) (CONS NIL NIL))
		     (T (APPEND (ADDFRONT (CAR U) (POWERSET (CDR U)))
				(POWERSET (CDR U))))))

	(DEFUN ADDFRONT (X V)
	       (COND ((NULL V) NIL)
		     (T (CONS (CONS X (CAR V)) (ADDFRONT X (CDR V))))))
.end

#. ⊗allsub[u,v]  
.begin  nofill select 2 

⊗⊗        allsub[u, v] ← allsub1[u, v, 1]⊗

⊗⊗        allsub1[u, v, n] ← ⊗
⊗⊗            qif qn v qthen qNIL⊗
⊗⊗            qelse qif match[u, v] qthen n . allsub1[u, qd v, add1 n]⊗
⊗⊗            qelse allsub1[u, qd v, add1 n]⊗

⊗⊗        match[u, v] ← ⊗
⊗⊗            qif qn u qthen qT qelse qif qn v qthen qNIL qelse qa u = qa v ∧ match[qd u, qd v]⊗
.end

.begin nofill select 6

	(DEFUN ALLSUB (U V) (ALLSUB1 U V 1.)) 

	(DEFUN ALLSUB1 (U V N) 
	       (COND ((NULL V) NIL)
		     ((MATCH U V) (CONS N (ALLSUB1 U (CDR V) (ADD1 N))))
		     (T (ALLSUB1 U (CDR V) (ADD1 N))))) 

	(DEFUN MATCH (U V) 
	       (COND ((NULL U) T)
		     ((NULL V) NIL)
		     (T (AND (EQUAL (CAR U) (CAR V))
			     (MATCH (CDR U) (CDR V)))))) 
.end

#. ⊗allsub![u,v] 
.begin nofill select 2

⊗⊗        allsub![u, v] ← allsub!1[u, v, 1]⊗

⊗⊗        allsub!1[u, v, n] ← ⊗
⊗⊗            qif qn v qthen qNIL⊗
⊗⊗            qelse qif match[u, v] qthen <n> . allsub!1[u, qd v, add1 n]⊗
⊗⊗            qelse qif qat qa v qthen allsub!1[u, qd v, add1 n]⊗
⊗⊗            qelse tack[n, allsub![u, qa v]] * allsub!1[u, qd v, add1 n]⊗

⊗⊗        tack[n, w] ← qif qn w qthen qNIL qelse [n . qa w] . tack[n, qd w]⊗
.end

.begin nofill select 6

	(DEFUN ALLSUB! (U V) (ALLSUB!1 U V 1.)) 

	(DEFUN ALLSUB!1 (U V N) 
	       (COND ((NULL V) NIL)
		     ((MATCH U V)
		      (CONS (LIST N) (ALLSUB!1 U (CDR V) (ADD1 N))))
		     ((ATOM (CAR V)) (ALLSUB!1 U (CDR V) (ADD1 N)))
		     (T (APPEND (TACK N (ALLSUB! U (CAR V)))
				(ALLSUB!1 U (CDR V) (ADD1 N)))))) 

	(DEFUN TACK (N W) 
	       (COND ((NULL W) NIL)
		     (T (CONS (CONS N (CAR W)) (TACK N (CDR W)))))) 
.end

#.  ⊗mapexp [or ⊗⊗maptree⊗]
.begin nofill select 2

⊗⊗        maptree[s, f1, f2] ← ⊗
⊗⊗            qif qat s qthen f1 s⊗
⊗⊗            qelse f2[maptree[qa s, f1, f2], maptree[qd s, f1, f2]]⊗
.end
.begin nofill select 6

	(DEFUN MAPTREE (S F1 F2) 
	       (COND ((ATOM S) (F1 S))
		     (T (F2 (MAPTREE (CAR S) F1 F2)
			    (MAPTREE (CDR S) F1 F2))))) 
.end

#. ⊗components[g]  
.begin  nofill select 2 

⊗⊗        components[g] ← ⊗
⊗⊗	      qif qn g qthen qNIL⊗
⊗⊗	      qelse peel[components1[qa g, qd g, qNIL, T]]⊗

⊗⊗	  peel[x] ← [qa x] . components[qd x]⊗

⊗⊗        components1[c,l,p,flag] ← ⊗
⊗⊗	      qif qn l ∧ (flag ∨ qn p) qthen c . p⊗
⊗⊗	      qelseif qn l qthen components1[c,p,qNIL,T]⊗
⊗⊗	      qelseif member[qa qa l,c] qthen components1[c * qa l,qd l,p,qNIL]⊗
⊗⊗	      qelse components1[c,qd l,qa l . p,flag]⊗
.end


.begin nofill select 6

	(DEFUN COMPONENTS (G) 
	       (COND ((NULL G) NIL)
		     (T (PEEL (COMPONENTS1 (CAR G) (CDR G) NIL T))))))

	(DEFUN PEEL (X) (CONS (CAR X) (COMPONENTS (CDR X))))

	(DEFUN COMPONENTS1 (C L P FLAG)
		(COND ((AND (NULL L) (OR FLAG (NULL P))) (CONS C P))
		      ((NULL L) (COMPONENTS C P NIL T))
		      ((MEMBER (CAAR L) C)
		       (COMPONENTS1 (APPEND C (CAR L)) (CDR L) P NIL))
		      (T (COMPONENTS1 C (CDR L) (CONS (CAR L) P) FLAG))))

.end